home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / UTILITY / MENUDLX / QUELLTXT / MENUDLX.LST < prev   
Encoding:
File List  |  1991-09-02  |  33.9 KB  |  1,118 lines
  1. '               G  F  A   -   M  E  N  U   -   D  e  l  u  x  e
  2. '               ===============================================
  3. '
  4. ' Filenamen:  MENUDLX.GFA (Programmfile)
  5. '             MENUDLX.INL
  6. '             MENUDLX.DAT (Filesystem)
  7. '             MENUDLX.TXT (Info-File)
  8. '
  9. ' Entwicklung:  Thomas Schaerer   Im Lindenhof 6   CH-8307 Effretikon
  10. '
  11. ' -----------------------------------------------------------------------------
  12. '
  13. '
  14. identification$=" MENUDLX.PRG ist programmiert in GFA-3.5-BASIC !"
  15. '
  16. defines         ! Startdefinitionen
  17. startup         ! Initialisierung
  18. main            ! Hauptprogramm
  19. '
  20. '
  21. > PROCEDURE defines       ! RESERVE, Comp-Opt, Aktueller Pfad, Definitionen
  22.   $E$             ! Fehlermeldung als Text.
  23.   $s&,s<,f<,p>    ! Compilations-Optionen.
  24.   $m7000          ! Speicherbedarf als Compilat.
  25.   RESERVE 7000    ! Speicherbedarf im Interpreter.
  26.   .PL73           ! Ausdruck: Anzahl Zeilen pro Seite.
  27.   .N0             ! Ausdruck: Ohne Zeilennummern.
  28.   path_read                                ! Aktueller Pfad lesen.
  29.   maindrive$=drive_read$                   !  Aufteilung nötig für Wieder-
  30.   mainpath_only$=path_read$                !  herstellung in 'main_path_write'.
  31.   mainpath$=maindrive$+":"+mainpath_only$+"\"     ! Vollständiger Pfad.
  32.   p$=mainpath$                                    ! p$ verändert sich.
  33.   '
  34.   button%=1
  35.   esc%=27                                 ! Escape-Sequenzen
  36.   t_wait$="G3WAIT=ON"                     ! _ nicht warten.
  37.   t_move$="G3MOVE=ON"                     ! _ nicht moven.
  38.   cobj$=""                                ! Zusätzliche O-Files für Linker.
  39. RETURN
  40. > PROCEDURE startup       ! Filesystem, BASEPAGE, Pulldown-Menu-Definitionen
  41.   CLS
  42.   file_parameter(pfad$,anz_zeichen%)      ! Fileparameter aus der BASEPAGE.
  43.   relat_absol_filepar                ! Pfad in BASEPAGE absolut oder relativ?
  44.   menudlx.dat                             ! Filesystem aus MENUDLX.DAT lesen.
  45.   '  file_system                             ! Das Filesystem betrachten.
  46.   IF anz_zeichen%>0
  47.     IF EXIST(pfad$)
  48.       IF RIGHT$(pfad$,4)=".GFA"
  49.         f$=pfad$
  50.         filepar_flag%=TRUE            ! Siehe weiter in Proz. 'do_fsel(...)'.
  51.       ELSE
  52.         sbb_bell
  53.         ALERT 1," |Sorry, aber mich interes- |sieren nur GFA-Files! ",1," Weiter | Abbruch",ret%
  54.         IF ret%=2
  55.           ende
  56.         ENDIF
  57.       ENDIF
  58.     ELSE
  59.       f$=""
  60.       sbb_bell
  61.       ALERT 1," |Filename existiert nicht |oder Pfad ist falsch! ",1," Weiter | Abbruch",ret%
  62.       IF ret%=2
  63.         ende
  64.       ENDIF
  65.     ENDIF
  66.   ENDIF
  67.   '
  68.   '
  69.   fh%=INT{L~A-46} !Zeichenhöhe
  70.   '                 INLINE: Zählen der Interpreterzeilen beim Compilieren:
  71.   INLINE irq%,&HD6
  72.   {irq%+2}=V:a&
  73.   BYTE{irq%+6}=32+35      !WORK_OUT(0)/8-5
  74.   DIM a$(100)
  75.   FOR i%=0 TO 100
  76.     READ a$(i%)
  77.     EXIT IF a$(i%)="*"
  78.   NEXT i%
  79.   coi&=0          ! Kein I
  80.   cos&=3          ! S& und s<
  81.   cof&=1          ! F<
  82.   cod&=0          ! Kein %3
  83.   com&=0          ! Kein *&
  84.   coe&=0          ! Kein E
  85.   cop&=0          ! Kein P>
  86.   dbsym&=0        ! keine DebugSymbole
  87.   auto&=0         ! Nicht xxx.prg aus xxx.gfa
  88.   DATA 
  89.   DATA  Wer steckt dahinter?
  90.   DATA -------------------------,1,2,3,4,5,6,
  91.   DATA File
  92.   DATA   Auswahl     ^A
  93.   DATA   Compiler    ^C
  94.   DATA   Interpreter ^I
  95.   DATA   Linker      ^L
  96.   DATA   RCS         ^R
  97.   DATA -----------------
  98.   DATA   Test        ^T
  99.   DATA   Execute     ^X
  100.   DATA -----------------
  101.   DATA   Quit        ^Q
  102.   DATA
  103.   DATA Optionen
  104.   DATA   Interrupts  ◆I
  105.   DATA   Select      ◆S
  106.   DATA   Functions   ◆F
  107.   DATA   Procedures  ◆P
  108.   DATA   IntDiv      ◆/
  109.   DATA   IntMul      ◆*
  110.   DATA   Error       ◆E
  111.   DATA -----------------
  112.   DATA   Memory      ◆M
  113.   DATA -----------------
  114.   DATA   DebugSym    ◆D
  115.   DATA
  116.   DATA Sets
  117.   DATA   G3WAIT   W
  118.   DATA   G3MOVE   M
  119.   DATA --------------
  120.   DATA   G3OBJ    O
  121.   DATA   G3PRG    P
  122.   DATA   G3LIB    L
  123.   DATA   PRG=GFA  F2
  124.   DATA   C-Object C
  125.   DATA
  126.   DATA Extras
  127.   DATA  Editor   ^E
  128.   DATA  Finder   ^F
  129.   DATA  GULAM    ^G
  130.   DATA  Hilfe    ^H
  131.   DATA  Filesystem
  132.   DATA  Undo (Bild)
  133.   DATA -------------
  134.   DATA ,,,*
  135.   MENU a$()
  136.   MENU 42,auto&
  137. RETURN
  138. > PROCEDURE main          ! DO --- ON MENU --- LOOP
  139.   ON MENU GOSUB men
  140.   ON MENU KEY GOSUB key
  141.   cur
  142.   @cls                    ! Hintergrund zum ersten Mal.
  143.   DO
  144.     ON MENU 100
  145.     laufzeichen
  146.     IF MOUSEK
  147.       CLR complink%       ! Löschwirkung durch MENU und Tastatur, siehe
  148.     ENDIF                 ! Prozedur 'check(x)'.
  149.     IF complink%=TRUE
  150.       complinkend         ! Blinkende Anzeige: Compilieren und Linken beendet.
  151.     ENDIF
  152.   LOOP
  153. RETURN
  154. '
  155. > PROCEDURE key                   ! Wird aufgerufen bei Tastendruck.
  156.   '  PRINT HEX$(MENU(14),4)'''' ! Test neuer CASE.
  157.   key%=MENU(14)
  158.   IF BYTE(key%)>64
  159.     SUB key%,32   !upper
  160.   ENDIF
  161.   SELECT BYTE(key%)             ! Diese ASCII-Codes ohne Scan-code
  162.   CASE "*","/","O","L","P","M","W","C"
  163.     key%=BYTE(key%)
  164.   ENDSELECT
  165.   SELECT key%           ! Nur die nötigen Tastenkombinationen sind wirksam.
  166.   CASE &H1E01,&H3B00,&H2E03,&H440,&H1709,&H260C,&H1312,&H1414,&H2D18,&H1011,&H4400
  167.     check(key%)
  168.   CASE &H1700,&H1F00,&H2100,&H1900,&H7E00,&H7F00,&H1200,&H3200,&H2000,&H3C00,&H2207
  169.     check(key%)
  170.   CASE &H1205,&H2106,&H2707,&H2308,&H6100,&H6200,"W","M","O","P","L","C","/","*"
  171.     check(key%)
  172.   ENDSELECT
  173. RETURN
  174. > PROCEDURE check(x%)             ! Wird aufgerufen bei Pulldownklick u. Taste.
  175.   LOCAL exten$,ret%,anz%
  176.   '
  177.   '  PRINT x%                    ! Test neuer Menu- und Tastenwerte.
  178.   '  STOP
  179.   CLR complink%
  180.   MENU KILL
  181.   SELECT x%
  182.   CASE -1                               !  Wer steckt dahinter....
  183.     hintergrund(7)
  184.     info(155,101)
  185.     @cls
  186.   CASE -11,&H1E01,&H3B00                !  ^A, F1
  187.     exec_flag%=NOT TRUE
  188.     do_fsel(".GFA",f$)
  189.     IF f$<>"" AND RIGHT$(f$,4)<>".GFA" AND button%=1
  190.       sbb_bell
  191.       ALERT 1," |Sorry, aber mich interes- |sieren nur GFA-Files!",1," Gewiss ",dummy%
  192.       CLR f$
  193.     ENDIF
  194.   CASE -12,&H2E03                       !  ^C
  195.     IF @chk_file(f$)
  196.       file_exist(weiter%)               !    Existiert das PRG/TOS-File schon?
  197.       IF weiter%=TRUE
  198.         keyclr
  199.         @cls
  200.         compile
  201.       ENDIF
  202.     ENDIF
  203.   CASE &H4400                           !  F10
  204.     IF @chk_file(f$)
  205.       file_exist(weiter%)               !   Existiert das PRG/TOS-File schon?
  206.       IF weiter%=TRUE
  207.         @cls
  208.         compile
  209.         IF e_com%=0                     !   Nur linken wenn Compil. ohne Fehler.
  210.           link
  211.           IF e_link%=0                  !   e_link + e_com = 0
  212.             PRINT                       !   Wegen Zeilenabstand.
  213.             PRINT
  214.             complink%=TRUE
  215.           ENDIF
  216.         ENDIF
  217.       ENDIF
  218.     ENDIF
  219.   CASE -13,&H1709                       !  ^I
  220.     interpr
  221.   CASE -14,&H260C                       !  ^L
  222.     file_exist(weiter%)                 !    Existiert das PRG/TOS-File schon?
  223.     IF weiter%=TRUE
  224.       @cls
  225.       link
  226.       IF e_com%=0 AND e_link%=0
  227.         PRINT                           !    Wegen Zeilenabstand.
  228.         PRINT
  229.         complink%=TRUE
  230.       ENDIF
  231.     ENDIF
  232.   CASE -15,&H1312                       !  ^R   GFA-Resource-Constr.-Set.
  233.     rcs
  234.   CASE -17,&H1414                       !  ^T   Test des comp. Programmes.
  235.     test_progr
  236.   CASE -18,&H2D18                       !  ^X   Aufruf eines ext. Programmes.
  237.     exec_flag%=TRUE
  238.     progr_ext
  239.     CLR button%
  240.   CASE -20,&H1011                       !  ^Q
  241.     endfrage                            !       Zur Alert-Box: Endfrage (ts).
  242.   CASE -23,&H1700                       !  ~I
  243.     INC coi&
  244.   CASE -24,&H1F00                       !  ~S
  245.     INC cos&
  246.   CASE -25,&H2100                       !  ~F
  247.     INC cof&
  248.   CASE -26,&H1900                       !  ~P
  249.     INC cop&
  250.   CASE -27,&H7E00,"/"                   !  /
  251.     INC cod&
  252.   CASE -28,&H7F00,"*"                   !  *
  253.     INC com&
  254.   CASE -29,&H1200                       !  ~E
  255.     INC coe&
  256.   CASE -31,&H3200                       !  ~M
  257.     PRINT AT(63,3);"Memory: ";
  258.     FORM INPUT 7 AS m$
  259.     n=INT(VAL(m$))
  260.     IF n>1000000000 OR n<=0
  261.       m$=""
  262.     ELSE
  263.       m$=STR$(n)
  264.     ENDIF
  265.   CASE -33,&H2000                       !  ~D
  266.     INC dbsym&
  267.   CASE -36,"W"                          !  W
  268.     SWAP twait$,t_wait$
  269.     help
  270.   CASE -37,"M"                          !  M
  271.     SWAP tmove$,t_move$
  272.     help
  273.   CASE -39,"O"                          !  O
  274.     in(tobj$)
  275.   CASE -40,"P"                          !  P
  276.     IF auto%=1
  277.       sbb_bell
  278.       ALERT 1,"Sie befinden sich im |Widerspruch! |PRG=GFA oder Editieren? |Beides geht nicht! ",1," Aha! ",dummy%
  279.     ELSE
  280.       in(tprg$)
  281.     ENDIF
  282.   CASE -41,"L"                          !  L
  283.     in(tlib$)
  284.   CASE &H6100                           !  undo
  285.     @cls
  286.   CASE &H6200                           !  help
  287.     help
  288.   CASE -42,&H3C00                       !  F2  Compilat = Filenamen oder nicht.
  289.     IF RIGHT$(f$,4)=".GFA"
  290.       auto%=XOR(auto%,1)                !    PRG=GFA oder nicht.
  291.       IF auto%=0
  292.         tprg$="G3PRG="+mainpath$+"COMPILAT\TEST.PRG"    ! Defaultpfad.
  293.       ENDIF
  294.       help
  295.     ELSE                ! Falls das GFA-File noch nicht gwählt wurde durch ^A.
  296.       sbb_bell
  297.       ALERT 1,"Sinnlose Umschaltung! | |Bitte wählen Sie erst |das GFA-File!",1," Okay! ",dummy%
  298.     ENDIF
  299.   CASE -43,"C"                          !  C    C-Objekt-Datei.
  300.     @cls
  301.     PRINT AT(1,7);" C-O-Files: ";
  302.     FORM INPUT 70 AS cobj$
  303.     @cls
  304.   CASE -46,&H1205                       !  ^E   Aufruf zusätzl. Editor.
  305.     editor
  306.   CASE -47,&H2106                       !  ^F   Aufruf eines File-Finders.
  307.     finder
  308.   CASE -48,&H2207                       !  ^G   Aufruf des GULAM.
  309.     gulam
  310.   CASE -49,&H2308                       !  ^H   Hilfe?
  311.     sbb_bell
  312.     ALERT 1," |Hahahahahaha... |Was Sie wollen MIR helfen? |",1," Äää... ",dummy%
  313.   CASE -50
  314.     file_system
  315.     @cls
  316.   CASE -51                              !  UNDO Bildregeneration.
  317.     @cls
  318.   ENDSELECT
  319.   MENU a$()
  320.   MENU 42,auto%                    ! Setzt Häckchen ins Pulldownfeld 'PRG=GFA'.
  321.   ON MENU GOSUB men
  322.   ON MENU KEY GOSUB key
  323.   com_opt
  324.   keyclr
  325.   menu_info
  326. RETURN
  327. > PROCEDURE men                   ! Wird aufgerufen bei Klick im Pulldown.
  328.   check(-MENU(0))
  329. RETURN
  330. > PROCEDURE cls                   ! Wiederaufbau des Menues.
  331.   PRINT AT(1,1)
  332.   ' ~FORM_DIAL(3,0,0,0,0,0,0,WORK_OUT(0),WORK_OUT(1))  ! Besser nicht...
  333.   hintergrund(3)
  334.   xx%=375                               ! Neustart des Laufzeichen.
  335.   titel
  336.   IF exec_flag%=NOT TRUE
  337.     com_opt                     ! Erneuerung der Optionen-Anzeige.
  338.   ENDIF
  339. RETURN
  340. > PROCEDURE help                  ! Anzeige von 'wait, move, Pfade'.
  341.   LOCAL anz%,i%
  342.   '
  343.   @cls
  344.   anz%=MAX(LEN(tmove$),LEN(tlib$),LEN(tobj$),LEN(tprg$),LEN(twait$))
  345.   cur
  346.   stor_curs
  347.   FOR i%=0 TO 4           ! Weisse Fläche für die Help-Wiedergabe richtet
  348.     PRINT SPACE$(anz%+1)  ! sich nach dem längsten darzustellenden String.
  349.   NEXT i%
  350.   restor_curs
  351.   PRINT UPPER$(twait$)    ! Help-Anzeige:       wait
  352.   PRINT UPPER$(tmove$)    !                     move
  353.   PRINT UPPER$(tlib$)     !                     Pfad der Haupt-Bibliothek.
  354.   PRINT UPPER$(tobj$)     !                     Pfad des GFA-Objektcodes.
  355.   PRINT UPPER$(tprg$)     !                     Pfad des Programmes.
  356. RETURN
  357. > PROCEDURE com_opt               ! Anzeige der Optionen.
  358.   LOCAL i%
  359.   '
  360.   co$=""
  361.   IF com& AND 1
  362.     co$=co$+" *&"
  363.   ENDIF
  364.   IF cod& AND 1
  365.     co$=co$+" %3"
  366.   ENDIF
  367.   IF cos& AND 1
  368.     co$=co$+" S&"
  369.   ENDIF
  370.   IF cos& AND 2
  371.     co$=co$+" S<"
  372.   ENDIF
  373.   IF coe& AND 1
  374.     co$=co$+" E$"
  375.   ENDIF
  376.   IF coe& AND 2
  377.     co$=co$+" E-"
  378.   ENDIF
  379.   IF coi& AND 1
  380.     co$=co$+" I+"
  381.   ENDIF
  382.   IF cof& AND 1
  383.     co$=co$+" F<"
  384.   ENDIF
  385.   IF cop& AND 1
  386.     co$=co$+" P>"
  387.   ENDIF
  388.   IF LEN(m$)
  389.     co$=co$+" m"+m$
  390.   ENDIF
  391.   IF auto%=1
  392.     IF RIGHT$(f$,4)=".GFA"
  393.       z$="G3PRG="+LEFT$(f$,LEN(f$)-4)+".PRG"
  394.       IF z$<>tprg$
  395.         tprg$=z$
  396.       ENDIF
  397.     ENDIF
  398.   ENDIF
  399.   IF LEN(co$)>lastlen_co%   ! Länge der weissen Fläche richtet sich nach dem
  400.     lastlen_co%=LEN(co$)    ! längsten Eintrag.
  401.   ENDIF
  402.   IF RIGHT$(f$,4)=".GFA"        ! Übernahme des Filenamens nur wenn es ein
  403.     ff$=f$                      ! GFA-File ist.
  404.   ELSE IF exec_flag=NOT TRUE AND button%=1
  405.     ff$="Nur GFA-File laden!"
  406.   ENDIF                         ! button% = Tasten der FS-Box.
  407.   i%=MAX(LEN(ff$),(LEN(cobj$)+8),lastlen_co%+5)  ! Länge des weissen Feldes.
  408.   DEFFILL 0
  409.   PBOX 2,fh%*2,10+(i%*8),5*fh%+2        ! Weisse Fläche für Schrift.
  410.   BOX 1,fh%*2-1,11+(i%*8),5*fh%+3       ! Rahmen um die weisse Fläche.
  411.   TEXT 3,fh%*3,ff$                      ! Auswahl-Pfad des GFA-Files..
  412.   TEXT 3,fh%*4,"Com:"+co$               ! Compileroptionen.
  413.   TEXT 3,fh%*5,"Lnk:"                   ! Linkeroptionen.
  414.   IF dbsym& AND 1
  415.     TEXT 43,fh%*5,"-s"                  ! Debug-Information
  416.   ENDIF
  417.   TEXT 67,fh%*5,UPPER$(cobj$)
  418.   cur
  419. RETURN
  420. > PROCEDURE do_fsel(x$,VAR f$)    ! Aufruf der Fileselector-Box.
  421.   LOCAL p1_new$
  422.   '
  423.   p1$=p$+"*"+x$
  424.   p1_new$=p1$                ! Wegen der Vorwahl des Extention-Knopfes.
  425.   '  f$=""                   ! verändert !!!!!!!!
  426.   IF FSEL_INPUT(p1_new$,file$,button%)
  427.     IF button%=1             ! Taste 'Okay'.
  428.       CLR filepar_flag%      ! Weil mit FS-Box neues File gelesen wurde.
  429.       p1$=p1_new$            ! Pfad wird nur mit 'Okay' übernommen.
  430.       f$=file$
  431.       file_mem$=file$        ! Zusatzspeicherung benötigt, weil 'f$' ändert.
  432.     ELSE                     ! Taste 'Abbruch'.
  433.       IF filepar_flag%=TRUE  ! Wenn MENUDLX mit Fileparameter gestartet
  434.         p1$=pfad$            ! und FS-Box abgebrochen wurde.
  435.         file_von_pfad        !   Filename aus Pfad maskieren.
  436.       ELSE
  437.         f$=file_mem$
  438.         x$=""
  439.       ENDIF
  440.     ENDIF
  441.     ' PRINT "Pfad: ";p1$           ! Nur für Parameter-Test.
  442.     ' PRINT "File: ";f$            !  "   "      "       " .
  443.     ' taste                        !  "   "      "       " .
  444.     IF RIGHT$(f$,4)=".TOS"
  445.       HIDEM                     ! Maus verstecken bei TOS-Programmen.
  446.     ENDIF
  447.     WHILE RIGHT$(f$)=CHR$(0)
  448.       f$=LEFT$(f$,LEN(f$)-1)
  449.     WEND
  450.     p%=RINSTR(p1$,"\")
  451.     IF p%
  452.       p1$=LEFT$(p1$,p%)
  453.     ENDIF
  454.     IF RIGHT$(f$)="."
  455.       f$=LEFT$(f$,LEN(f$)-1)
  456.     ENDIF
  457.     IF f$<>""
  458.       IF INSTR(f$,".")=0
  459.         f$=f$+x$
  460.       ENDIF
  461.       f$=p1$+f$
  462.       p$=p1$
  463.     ENDIF
  464.   ELSE
  465.     f$=""
  466.   ENDIF
  467.   @cls          ! Damit nach der Filesectorbox der Titel wieder erscheint.
  468. RETURN
  469. > PROCEDURE cur                   ! Sorgt für 'crslin > 7'  and  'crscol = 1'.
  470.   IF CRSLIN<7
  471.     PRINT AT(1,7);
  472.   ENDIF
  473.   IF CRSCOL>1
  474.     PRINT
  475.   ENDIF
  476.   SETCOLOR 0,&H777
  477.   SETCOLOR 3,0
  478.   SETCOLOR 15,0
  479.   DEFMOUSE 0
  480. RETURN
  481. > PROCEDURE interpr               ! Interpreter
  482.   LOCAL ret%
  483.   '
  484.   IF LEN(f$) AND RIGHT$(f$,4)=".GFA"
  485.     f1$=" - "+f$                      ! Wird dem Interpreter übergeben.
  486.     ret%=1
  487.   ELSE
  488.     f1$=""
  489.     sbb_bell
  490.     ALERT 1," |GFA-File wurde nicht geladen! |Was soll geschehen? ",1," INTERP. | Menu ",ret%
  491.   ENDIF
  492.   IF ret%=1
  493.     revrs_curs
  494.     anz%=MAX(LEN(gfaint$),LEN(f$))
  495.     PRINT AT(1,18);
  496.     stor_curs
  497.     FOR i%=0 TO 1                       ! Damit beide Zeilen gleich lang werden.
  498.       PRINT SPACE$(anz%+26)
  499.     NEXT i%
  500.     restor_curs
  501.     PRINT " Starting (Interpreter): ";gfaint$   ! Pfad des Interpreters.
  502.     PRINT " Starting (GFA-File):    ";f$        ! Pfad des GFA-Files.
  503.     norm_curs
  504.     PAUSE 50                        ! Damit Pfade etwas länger lesbar sind (ts).
  505.     IF f$<>""
  506.       pfad_file$=f$
  507.       pfad_nur                      ! Pfad ohne Filename.
  508.       p_current$=pfadnur$           ! Anpassung des aktuellen Pfades an den
  509.       new_path_write                ! des GFA-Files welches ausgewählt wurde.
  510.     ENDIF
  511.     t%=TIMER
  512.     e%=EXEC(0,gfaint$,f1$,"")
  513.     main_path_write
  514.     IF e%=-33
  515.       sbb_bell
  516.       ALERT 1," | |Leider ist der Interpreter |nicht ansprechbar!",1," Aha! ",dummy%
  517.     ELSE
  518.       @cls             ! Zurück von ext. Programm, wieder grauer Hintergrund (ts).
  519.       revrs_curs
  520.       PRINT "Arbeitszeit im Interpreter:"
  521.       norm_curs
  522.       tmx
  523.     ENDIF
  524.   ENDIF
  525. RETURN
  526. > PROCEDURE compile               ! Compiler
  527.   revrs_curs
  528.   PRINT AT(1,7);"Ruhe, ich übersetze gerade!  "
  529.   norm_curs
  530.   stor_curs
  531.   t%=TIMER
  532.   env
  533.   i_on
  534.   PRINT AT(30,1);"                ";
  535.   PRINT AT(42,1);"<--- Zeile"        ! Daneben die Zeilennummern.
  536.   restor_curs           ! Der Compiler setzt manchmal den Cursor auf 1,1.
  537.   e_com%=EXEC(0,gfacom$,"X"+f$+co$,env$)
  538.   IF e_com%=-33
  539.     sbb_bell
  540.     ALERT 1," |Wie soll ich bloss ein GFA- |File übersetzen, wenn ich |keinen COMPILER finde!",1," Stimmt ",dummy%
  541.   ELSE IF e_com%>0
  542.     sbb_bell
  543.     ALERT 1," |Eine böse Überraschung! |"+STR$(e_com%)+" Befehle wurden nicht | übersetzt.",1,"Abbruch!",dummy%
  544.   ENDIF
  545.   i_off
  546.   tmx
  547. RETURN
  548. > PROCEDURE link                  ! Linker
  549.   HIDEM
  550.   revrs_curs
  551.   PRINT AT(1,11);"Ich linke jetzt!             "
  552.   norm_curs
  553.   t%=TIMER
  554.   IF dbsym& AND 1
  555.     s$="-s "
  556.   ELSE
  557.     s$=""
  558.   ENDIF
  559.   env
  560.   e_link%=EXEC(0,gfalnk$,"X"+s$+cobj$,env$)
  561.   IF e_link%=0
  562.     tmx
  563.   ELSE IF e_link%=-33
  564.     tmx
  565.     sbb_bell
  566.     ALERT 1," |Entweder ist der LINKER nicht |anwesend, oder es hat Fehler |in den Parametern! ",1," Hmmm? ",dummy%
  567.   ELSE IF e_link%>0
  568.     cl_line_after_curs
  569.     PRINT
  570.     cl_line_after_curs
  571.     PRINT
  572.     tmx
  573.     cls_after_curs
  574.     sbb_bell
  575.     ALERT 1," |Anzahl undefinierter Symbole |und/oder Offsetüberschrei- |tungen:  "+STR$(e_link%),1," Ojee! ",dummy%
  576.   ENDIF
  577.   keyclr
  578.   SHOWM
  579. RETURN
  580. > PROCEDURE test_progr            ! Starten des compilierten Programmes.
  581.   t$=UPPER$(MID$(tprg$,7))
  582.   IF EXIST(t$)
  583.     IF RIGHT$(t$,4)=".TTP"
  584.       sbb_bell
  585.       ALERT 1,"Um TTP-Programme zu starten, |benutzen Sie einen Zeilen- |kommandointerpreter oder |eine geeignete Shell!",1," Jawohl ",dummy%
  586.     ELSE
  587.       IF t$<>""
  588.         pfad_file$=t$
  589.         pfad_nur                      ! Pfad ohne Filename.
  590.         p_current$=pfadnur$           ! Anpassung des aktuellen Pfades an den
  591.         new_path_write                ! des GFA-Files welches ausgewählt wurde.
  592.       ENDIF
  593.       hintergrund(7)
  594.       revrs_curs
  595.       PRINT AT(1,17);"Executing: ";t$  ! Programmstart-Anzeige.
  596.       norm_curs
  597.       PAUSE 37
  598.       t%=TIMER
  599.       SHOWM
  600.       ~EXEC(0,t$,"","")
  601.       main_path_write           ! Hauptpfad wiederherstellen.
  602.       @cls         ! Zurück von comp. Programm, wieder grauer Hintergrund (ts).
  603.       revrs_curs
  604.       PRINT "Arbeitszeit des Testprogrammes:"
  605.       norm_curs
  606.       tmx
  607.     ENDIF
  608.   ELSE
  609.     sbb_bell
  610.     ALERT 1,"| | Wo nichts ist, | läuft auch nichts! ",1," Jaja! ",dummy%
  611.   ENDIF
  612. RETURN
  613. > PROCEDURE progr_ext             ! Aufruf eines externen Programmes.
  614.   ALERT 2," | |PRG  oder  TOS ? |Das ist hier die Frage. ",1," PRG | TOS ",ret%
  615.   IF ret%=1         ! Entscheiden zwischen PRG oder TOS.
  616.     exten$=".PRG"
  617.   ELSE IF ret%=2
  618.     exten$=".TOS"   ! Maus verstecken HIDEM folgt direkt vor TOS-Aufruf.
  619.   ENDIF
  620.   do_fsel(exten$,x$) ! HIDEM in dieser Prozedur, falls TOS gilt.
  621.   IF button%=1 AND (RIGHT$(file$,4)=".PRG" OR RIGHT$(file$,4)=".TOS")
  622.     p_current$=p$
  623.     new_path_write            ! Neuer Pfad für externes Programm.
  624.     hintergrund(7)
  625.     revrs_curs
  626.     PRINT AT(1,17);"Executing: ";UPPER$(x$)
  627.     norm_curs
  628.     PAUSE 37
  629.     t%=TIMER
  630.     e%=EXEC(0,x$,"","")     ! Nur falls PRG oder TOS gewählt wurde.
  631.     main_path_write           ! Hauptpfad wiederherstellen.
  632.     SHOWM       ! Wenn von xxxx.TOS retour nötig.
  633.     @cls        ! Zurück von ext. Programm, wieder grauer Hintergrund.
  634.     cur
  635.     revrs_curs
  636.     PRINT "Arbeitszeit des externen Programmes:"
  637.     norm_curs
  638.     tmx
  639.   ELSE IF button%=1 AND RIGHT$(file$,4)=".TTP"
  640.     sbb_bell
  641.     ALERT 1,"Um TTP-Programme zu starten, |benutzen Sie GULAM oder |einen andern Zeilenkommando- |interpreter!",1," Jawohl ",dummy%
  642.   ELSE IF button%=1
  643.     sbb_bell
  644.     ALERT 1,"| |PRG oder TOS sollte |es schon sein! ",1," Klar! ",dummy%
  645.   ENDIF
  646.   exec_flag%=NOT TRUE
  647. RETURN
  648. > PROCEDURE rcs                   ! Direktaufruf des GFA-Recource-Constr.-Set.
  649.   hintergrund(7)
  650.   revrs_curs
  651.   PRINT AT(1,18);"Starting: ";gfarcs$
  652.   norm_curs
  653.   t%=TIMER
  654.   SHOWM
  655.   e%=EXEC(0,gfarcs$,"","")
  656.   IF e%=-33                       ! RSC gibt es nicht.
  657.     sbb_bell
  658.     ALERT 1,"|Tut mir leid, aber das |Resource-Programm konnte |ich nicht finden! ",1," Ach so ",dummy%
  659.     @cls
  660.   ELSE
  661.     @cls
  662.     revrs_curs
  663.     PRINT "Arbeitszeit im Resource-Constr.-Set:"
  664.     norm_curs
  665.     tmx
  666.   ENDIF
  667. RETURN
  668. > PROCEDURE env                   ! Environment-String für den Compiler.
  669.   n$=CHR$(0)
  670.   env$=tobj$+n$+tprg$+n$+tlib$+n$+twait$+n$+tmove$+n$
  671. RETURN
  672. > PROCEDURE in(VAR a$)            ! Editieren der Pfade.
  673.   b$=MID$(a$,7)
  674.   revrs_curs
  675.   PRINT AT(1,17);"Editiere: "
  676.   norm_curs
  677.   PRINT AT(1,17);
  678.   PRINT LEFT$(a$,6);
  679.   FORM INPUT 60 AS b$
  680.   b$=TRIM$(b$)
  681.   IF LEN(b$)
  682.     a$=LEFT$(a$,6)+b$
  683.   ENDIF
  684.   help
  685. RETURN
  686. > PROCEDURE i_on
  687.   IF INT{irq%}                  ! nix wenn irq% leer
  688.     p%=LPEEK(&H456)
  689.     FOR i%=p% TO p%+31 STEP 4
  690.       IF LPEEK(i%)=0
  691.         SLPOKE i%,irq%
  692.         i%=p%+31
  693.       ENDIF
  694.     NEXT i%
  695.     {BASEPAGE+132}=irq%
  696.     {BASEPAGE+128}=&H4030201
  697.   ENDIF
  698. RETURN
  699. > PROCEDURE i_off
  700.   {BASEPAGE+128}=0
  701.   p%=LPEEK(&H456)
  702.   FOR i%=p% TO p%+31 STEP 4
  703.     IF LPEEK(i%)=irq%
  704.       SLPOKE i%,0
  705.     ENDIF
  706.   NEXT i%
  707. RETURN
  708. > PROCEDURE keyclr
  709.   REPEAT                      ! Lösche GEM Tastaturpuffer.
  710.   UNTIL EVNT_MULTI(33,0,0,0,0,0,0,0,0,0,0,0,0,0,0,100)=32
  711. RETURN
  712. > PROCEDURE endfrage
  713.   LOCAL button%
  714.   '                                                 Aus PROCEDURE chek(x%)
  715.   sbb_bell
  716.   message$="| |Haben Sie wirklich etwas |Besseres vor? "
  717.   button$=" Klar! | Nein. "
  718.   ALERT 2,message$,2,button$,button%                ! Alertbox - Endfrage
  719.   IF button%=1
  720.     ende
  721.   ENDIF
  722. RETURN
  723. > PROCEDURE ende
  724.   RESERVE     ! Speicher wider freigeben.
  725.   CLS
  726.   EDIT        ! Falls etwas verbessert werden soll im Interpreter....
  727. RETURN
  728. '
  729. > PROCEDURE info(x%,y%) ! Bildmitte ca. x = 155 , y = 101 , nur unger. Zahlen.
  730.   HIDEM
  731.   GRAPHMODE 1
  732.   DEFFILL 1,2,8
  733.   PBOX x%+5,y%+5,x%+361,y%+231
  734.   DEFFILL 0,2,8
  735.   PBOX x%,y%,x%+356,y%+226
  736.   DEFFILL 1,2,4
  737.   PBOX x%+3,y%+3,x%+353,y%+223
  738.   BOX x%+2,y%+2,x%+354,y%+224
  739.   BOX x%,y%,x%+356,y%+226
  740.   schreibe(x%+26,y%+41,26,"GFA-MENU-DELUXE")
  741.   schreibe(x%+26,y%+80,16,"Thomas Schaerer ")
  742.   schreibe(x%+26,y%+104,16,"Im Lindenhof 6")
  743.   schreibe(x%+26,y%+128,16,"CH-Effretikon (Schweiz)")
  744.   schreibe(x%+26,y%+155,8,"Dieses Programm wird mit der")
  745.   schreibe(x%+26,y%+169,8,"dazugehörigen GFA-3.5-BASIC-")
  746.   schreibe(x%+26,y%+183,8,"Datei, gratis an GFA-Basic-")
  747.   schreibe(x%+26,y%+197,8,"Enthusiasten weitergegeben.")
  748.   REPEAT
  749.   UNTIL MOUSEK=0
  750.   REPEAT
  751.     GOSUB schreibe(x%+26,y%+41,26,"GFA-MENU-DELUXE")
  752.     GRAPHMODE 3
  753.   UNTIL MOUSEK=1 OR MOUSEK=2 OR INKEY$<>""
  754.   GRAPHMODE 1
  755.   SHOWM
  756. RETURN
  757. > PROCEDURE schreibe(xx%,yy%,zz%,text$)   ! Gehört zur Prozedur 'info'.
  758.   DEFTEXT 1,0,0,zz%
  759.   GRAPHMODE 2
  760.   TEXT xx%,yy%,text$
  761.   DEFTEXT 1,2,0,zz%
  762.   GRAPHMODE 3
  763.   TEXT xx%-1,yy%-1,text$
  764.   GRAPHMODE 1
  765. RETURN
  766. > PROCEDURE hintergrund(muster%)
  767.   DEFFILL 1,2,muster%
  768.   PBOX -1,18,640,400
  769. RETURN
  770. > PROCEDURE tmx         ! Vollständig neue Zeitanzeige in H:M:S (ts).
  771.   cur
  772.   d_time=(TIMER-t%)/200                  ! Zeitdifferenz in Sekunden
  773.   PRINT "Zeit:  ";
  774.   IF d_time<60
  775.     PRINT USING "##.###",d_time;
  776.     PRINT " Sek.  ";
  777.   ELSE IF d_time<3600
  778.     PRINT INT(d_time/60);" Min.  ";
  779.     PRINT USING "##.###",d_time MOD 60;
  780.     PRINT " Sek.  ";
  781.   ELSE
  782.     PRINT INT(d_time/3600);" Std.  ";INT(d_time/60) MOD 60;" Min.  ";
  783.     PRINT USING "##.###",d_time MOD 60;
  784.     PRINT " Sek.  ";
  785.   ENDIF
  786. RETURN
  787. > PROCEDURE menu_info   ! Zusätzliche Infos über Einstellungen in Menuzeile.
  788.   IF auto%=1
  789.     stor_curs
  790.     revrs_curs
  791.     PRINT AT(65,1);"PRG=GFA";
  792.     norm_curs
  793.     restor_curs
  794.   ENDIF
  795. RETURN
  796. > PROCEDURE titel       ! GFA-MENU-DELUXE
  797.   DEFFILL 1,1,8
  798.   PBOX -1,360,640,400
  799.   GRAPHMODE 3
  800.   DEFTEXT 1,4,0,18
  801.   TEXT 1,380,"G F A  -  M E N U E  -  D e l u x e"
  802.   DEFTEXT 1,0,0,6
  803.   TEXT 500,380,"GFA-3.x-BASIC"
  804.   DEFTEXT 1,4,0,6
  805.   TEXT 1,398,"Für den    I N T E R P R E T E R    und den    C O M P I L E R ."
  806.   DEFTEXT 1,0,0,13        ! Wieder normale Schrift
  807.   GRAPHMODE 0
  808.   PRINT AT(1,20);
  809.   PRINT "  <F10>  = Kompilieren und Linken, nach Auswahl (^A oder F1).  "
  810.   PRINT "  <HELP> = Parameter des Sets-Menue und Bildregeneration.      "
  811.   PRINT "  <UNDO> = Bildregenaration des Menue  (z.B. nach Accessory).  "
  812.   curs_home
  813. RETURN
  814. > PROCEDURE laufzeichen
  815.   DEFTEXT 1,0,0,4
  816.   GRAPHMODE 3
  817.   IF xx%<550 OR xx%>620         !   Dies ist einerseits eine Spielerei, ander-
  818.     xx%=550                     !   seits kann man gewisse Abstürze leicht
  819.   ENDIF                         !   durch dessen Stoppen erkennen.
  820.   TEXT xx%,398,"_"              !   Und überhaupt, warum immer alles so tie-
  821.   ADD xx%,3                     !   risch ernst?
  822.   DEFTEXT 1,0,0,13
  823.   GRAPHMODE 0
  824. RETURN
  825. > PROCEDURE sbb_bell    ! Klingt wie eine Schweizer Bahnhofglocke.
  826.   ~XBIOS(28,&HF8,7+128)              !  3 Tonkanäle
  827.   ~XBIOS(28,16,8+128)                !  Hüllk.  Kanal 1
  828.   ~XBIOS(28,16,9+128)                !  Hüllk.  Kanal 2
  829.   ~XBIOS(28,16,10+128)               !  Hüllk.  Kanal 3
  830.   ~XBIOS(28,0,11+128)                !  Hüllk.  Lowbyte
  831.   ~XBIOS(28,30,12+128)               !  Hüllk.  Highbyte
  832.   ~XBIOS(28,9,13+128)                !  Hüllk.  abklingend
  833.   ~XBIOS(28,63,0+128)                !  Tonfreq.  Lowbyte    Kanal 1
  834.   ~XBIOS(28,0,1+128)                 !  Tonfreq.  Highbyte   Kanal 1
  835.   ~XBIOS(28,50,2+128)                !  Tonfreq.  Lowbyte    Kanal 2
  836.   ~XBIOS(28,0,3+128)                 !  Tonfreq.  Highbyte   Kanal 2
  837.   ~XBIOS(28,37,4+128)                !  Tonfreq.  Lowbyte    Kanal 3
  838.   ~XBIOS(28,0,5+128)                 !  Tonfreq.  Highbyte   Kanal 3
  839. RETURN
  840. > PROCEDURE editor      ! Aufruf zu zusätzlichem Editor, z.B. Textvergleich.
  841.   LOCAL edit_par$,ret%
  842.   '
  843.   ret%=1                ! Damit ohne Parameter Editor gestartet werde kann.
  844.   IF ff$<>"Nur GFA-File laden!"  ! LST-File nur suchen wenn GFA-File geladen.
  845.     IF EXIST(LEFT$(ff$,(LEN(ff$)-4))+".LST")    ! Zum geladenen GFA-File das
  846.       edit_par$=LEFT$(ff$,(LEN(ff$)-4))+".LST"  ! gleichnamige LST-File suchen.
  847.     ELSE
  848.       CLR edit_par$     ! Parameter löschen, falls keines gesendet wird.
  849.       sbb_bell
  850.       ALERT 1,"Sie haben vergessen ein |LST-File zu erzeugen! |Weiter zum Editor oder zurück |ins Menu?",1," Editor | Menu ",ret%
  851.     ENDIF
  852.   ENDIF
  853.   IF ret%=1             ! Editor starten mit oder ohne File-Parameter.
  854.     hintergrund(7)
  855.     revrs_curs
  856.     PRINT AT(1,18);"Starting (Editor):   ";editor$
  857.     PRINT AT(1,19);"Starting (LST-File): ";edit_par$
  858.     norm_curs
  859.     PAUSE 37
  860.     t%=TIMER
  861.     SHOWM
  862.     e%=EXEC(0,editor$,CHR$(LEN(edit_par$))+edit_par$+CHR$(0),"")     ! Run
  863.     IF e%=-33                                           ! Editor gibt es nicht.
  864.       sbb_bell
  865.       ALERT 1,"|Tut mir leid, aber der |zusätzliche Editor ist |in St. Anderswo! ",1," Na ja. ",dummy%
  866.       @cls
  867.     ELSE
  868.       @cls
  869.       revrs_curs
  870.       PRINT "Arbeitszeit im zusätzlichen Editor: "
  871.       norm_curs
  872.       tmx
  873.     ENDIF
  874.   ENDIF
  875. RETURN
  876. > PROCEDURE finder      ! Aufruf eines File-Finders, z.B. QUICKFIND.
  877.   LOCAL ret%
  878.   '
  879.   hintergrund(7)
  880.   revrs_curs
  881.   PRINT AT(1,18);"Starting (Finder):   ";finder$
  882.   norm_curs
  883.   PAUSE 37
  884.   t%=TIMER
  885.   IF EXIST(finder$)
  886.     stor_curs
  887.     revrs_curs
  888.     PRINT AT(1,24);
  889.     PRINT " ACHTUNG:  Bei Verwendung des QUICKFIND.PRG   <Control-C> -  "
  890.     PRINT " Abbruch nicht benutzen, sonst Verhalten der Maus gestört!   ";
  891.     norm_curs
  892.     restor_curs
  893.     e%=EXEC(0,finder$,"","")     ! Run
  894.     @cls
  895.     revrs_curs
  896.     PRINT "Arbeitszeit im File-Finder: "
  897.     norm_curs
  898.     tmx
  899.   ELSE
  900.     sbb_bell
  901.     ALERT 1,"|Tut mir leid, aber der File- |Finder ist nicht zu finden! ",1," Na ja. ",dummy%
  902.     @cls
  903.   ENDIF
  904. RETURN
  905. > PROCEDURE gulam       ! Aufruf des GULAM-Zeilenkommandointerpreters.
  906.   pfad_file$=gulam$
  907.   pfad_nur
  908.   p_current$=pfadnur$
  909.   new_path_write            ! Pfad damit GULAM.PRG sein GULAM.G findet.
  910.   hintergrund(7)
  911.   revrs_curs
  912.   PRINT AT(1,17);"Executing: ";UPPER$(gulam$)
  913.   norm_curs
  914.   PAUSE 37
  915.   HIDEM
  916.   t%=TIMER
  917.   e%=EXEC(0,gulam$,"","")   ! GULAM - Aufruf.
  918.   main_path_write           ! Hauptpfad wiederherstellen.
  919.   SHOWM       ! Wenn von xxxx.TOS retour nötig.
  920.   @cls        ! Zurück von ext. Programm, wieder grauer Hintergrund.
  921.   cur
  922.   revrs_curs
  923.   PRINT "Arbeitszeit im GULAM:"
  924.   norm_curs
  925.   tmx
  926. RETURN
  927. > PROCEDURE complinkend ! Blinkende Meldung nach Comp.- und Link.-Ende.
  928.   INC blink%
  929.   IF (blink% MOD 6=0) OR (blink% MOD 6=1) OR (blink% MOD 6=2)
  930.     revrs_curs
  931.   ENDIF
  932.   stor_curs
  933.   PRINT "Compilieren und Linken erfolgreich beendet!"
  934.   restor_curs
  935.   norm_curs
  936. RETURN
  937. > FUNCTION chk_file(VAR f$)
  938. $F%                   ! Compiler: ENDFUNC-Behandlung.
  939. IF LEN(f$)
  940.   IF EXIST(f$)
  941.     RETURN TRUE
  942.   ENDIF
  943. ENDIF
  944. do_fsel(".GFA",f$)
  945. IF LEN(f$)
  946.   IF EXIST(f$)
  947.     RETURN TRUE
  948.   ENDIF
  949. ENDIF
  950. RETURN FALSE
  951. ENDFUNC
  952. > PROCEDURE file_exist(VAR weiter%)
  953. pfad_file$=MID$(tprg$,7)      ! Filtert Pfad + Filename.
  954. pfad_nur                      ! Filtert Pfad.
  955. IF EXIST(pfad_file$)     ! Existiert Pfad u. PRG/TOS-File bereits?
  956.   sbb_bell
  957.   ALERT 2,"Dateiname existiert bereits! | |Überschreiben = Weiter |Zurück =        Menu ",1," Weiter | Menu ",weiter%
  958.   IF weiter%=1
  959.     weiter%=TRUE
  960.   ELSE
  961.     weiter%=NOT TRUE          ! Keine weiteren Aktionen.
  962.   ENDIF
  963. ELSE
  964.   weiter%=TRUE
  965. ENDIF
  966. RETURN
  967. > PROCEDURE file_parameter(VAR pfad$,anz_zeichen%)  ! Filepar. aus der BASEPAGE
  968. LOCAL i%,c|
  969. '
  970. adr%=BASEPAGE
  971. FOR i%=129 TO 256
  972.   anz_zeichen%=i%-129
  973.   c|=PEEK(adr%+i%)
  974.   EXIT IF c|=0 OR c|=13       ! Endung NULL oder <RETURN>.
  975.   pfad$=pfad$+CHR$(c|)        !
  976. NEXT i%
  977. pfad$=UPPER$(pfad$)
  978. RETURN
  979. > PROCEDURE file_von_pfad       ! Siehe Prozedur 'do_fsel(...)'.
  980. LOCAL i%
  981. '
  982. FOR i%=0 TO 13                ! Maskiert den Filenamen mit Extension
  983.   f$=RIGHT$(p1$,i%)           ! aus dem ganzen Pfad.
  984.   EXIT IF LEFT$(f$,1)="\"
  985. NEXT i%
  986. f$=RIGHT$(f$,(LEN(f$)-1))     ! Conversion in Grossbuchstaben.
  987. RETURN
  988. > PROCEDURE pfad_nur
  989. LOCAL i%,n$
  990. '
  991. FOR i%=0 TO 13
  992.   n$=RIGHT$(pfad_file$,i%)
  993.   EXIT IF LEFT$(n$)="\"
  994. NEXT i%
  995. pfadnur$=LEFT$(pfad_file$,(LEN(pfad_file$)-i%))+"\"
  996. RETURN
  997. > PROCEDURE new_path_write      ! Neuer Pfad für externes Programm.
  998. CHDRIVE p_current$                            ! Laufwerk \ Pfad
  999. CHDIR MID$(p_current$,3,(LEN(p_current$)-3))  ! Pfad alleine ohne Laufwerk.
  1000. RETURN
  1001. > PROCEDURE main_path_write     ! Pfad dieses Menu wiederherstellen.
  1002. CHDRIVE maindrive$
  1003. CHDIR mainpath_only$
  1004. RETURN
  1005. > PROCEDURE path_read           ! Testen ob aktueller Pfad übernommen wurde.
  1006. drive_read$=CHR$(GEMDOS(25)+65)       ! Laufwerk
  1007. path_read$=DIR$(0)                    ! Pfad ohne Laufwerk
  1008. RETURN
  1009. > PROCEDURE menudlx.dat         ! Lesen des GFA-MENU-Deluxe-Filesystem.
  1010. IF EXIST(mainpath$+"menudlx.dat")
  1011.   OPEN "I",#1,mainpath$+"menudlx.dat"
  1012.   INPUT #1,gfaint$,gfacom$,gfalnk$,gfarcs$,editor$,finder$,gulam$,tobj$,tprg$,tlib$
  1013.   CLOSE #1
  1014. ELSE
  1015.   sbb_bell
  1016.   ALERT 1,"|Tut mir leid, aber |MENUDLX.DAT konnte ich |nicht finden! ",2," Weiter | Abbruch",ret%
  1017.   IF ret%=2
  1018.     ende
  1019.   ENDIF
  1020. ENDIF
  1021. '
  1022. gfaint$=mainpath$+gfaint$     ! Interpreter GFA_3.PRG
  1023. gfacom$=mainpath$+gfacom$     ! Compiler    BCOMP.PRG
  1024. gfalnk$=mainpath$+gfalnk$
  1025. gfarcs$=mainpath$+gfarcs$
  1026. ' editor$=editor$             ! Zusätzlicher Editor, Filefinder und UNIX-
  1027. ' finder$=finder$             ! Zeilenkommandointerpreter sind ausserhalb des
  1028. ' gulam$=gulam$               ! der GFA-3.5-Basic-Fileordnung.
  1029. tobj$="G3OBJ="+mainpath$+tobj$
  1030. tprg$="G3PRG="+mainpath$+tprg$
  1031. tlib$="G3LIB="+mainpath$+tlib$
  1032. RETURN
  1033. > PROCEDURE relat_absol_filepar ! Pfad in BASEPAGE absolut oder relativ?
  1034. IF MID$(pfad$,2,1)<>":"
  1035.   pfad$=mainpath$+pfad$       ! Wenn der eingegebene Pfad relativ ist.
  1036. ENDIF
  1037. RETURN
  1038. '
  1039. '                         Testprozeduren:
  1040. > PROCEDURE path_test         ! Nur für Test (Direct_Mode).
  1041. path_read                      ! Testen ob aktueller Pfad übernommen wurde.
  1042. PRINT
  1043. PRINT
  1044. PRINT "Laufwerk: ";drive_read$
  1045. PRINT "Nur Pfad: ";path_read$
  1046. RETURN
  1047. > PROCEDURE file_system       ! Auch für Test (Direct-Mode).
  1048. esc%=27                   ! Falls im Direct-Mode gestartet wird.
  1049. CLS
  1050. revrs_curs
  1051. PRINT " Filesystem des GFA-MENU-Deluxe. "
  1052. norm_curs
  1053. PRINT
  1054. PRINT " Aktueller Pfad:               ";mainpath$
  1055. PRINT
  1056. PRINT " Interpreter (GFA_3.PRG):      ";gfaint$
  1057. PRINT " Compiler (GFA_BCOM.PRG):      ";gfacom$
  1058. PRINT " Linker (GL-PRG):              ";gfalnk$
  1059. PRINT " Resource-C-S (RCS2.PRG):      ";gfarcs$
  1060. PRINT " Zusätzlicher Editor:          ";editor$
  1061. PRINT " Finder /QUIKFIND.PRG):        ";finder$
  1062. PRINT " UNIX-Shell (GULAM.PRG):       ";gulam$
  1063. PRINT
  1064. PRINT " Defaultpfad Objectcode:       ";tobj$
  1065. PRINT " Defaultpfad (TEST.PRG):       ";tprg$
  1066. PRINT " Defaultfad (GFA3LIB):         ";tlib$
  1067. PRINT
  1068. revrs_curs
  1069. PRINT AT(1,25);" Weiter:  Drücke Keyboard- oder Maustaste. ";
  1070. norm_curs
  1071. catchkey
  1072. REPEAT
  1073. UNTIL MOUSEK=0
  1074. REPEAT
  1075. UNTIL INKEY$<>"" OR MOUSEK
  1076. CLS
  1077. RETURN
  1078. '
  1079. '                         Escape-Sequenzen:
  1080. > PROCEDURE curs_home
  1081. PRINT CHR$(esc%)+"H";
  1082. RETURN
  1083. > PROCEDURE revrs_curs
  1084. PRINT CHR$(esc%)+"p";
  1085. RETURN
  1086. > PROCEDURE norm_curs
  1087. PRINT CHR$(esc%)+"q";
  1088. RETURN
  1089. > PROCEDURE stor_curs
  1090. PRINT CHR$(esc%)+"j";
  1091. RETURN
  1092. > PROCEDURE restor_curs
  1093. PRINT CHR$(esc%)+"k";
  1094. RETURN
  1095. > PROCEDURE cl_line_after_curs           ! Zeile löschen ab Cursor
  1096. PRINT CHR$(esc%)+"K";
  1097. RETURN
  1098. > PROCEDURE cls_after_curs               ! Bildschirm löschen ab Cursor
  1099. PRINT CHR$(esc%)+"J";
  1100. RETURN
  1101. '
  1102. > PROCEDURE catchkey       ! Abfangen unerlaubter Tastenbetätigungen
  1103. LOCAL keybuff%
  1104. '
  1105. REPEAT
  1106.   KEYTEST keybuff%
  1107. UNTIL keybuff%=0
  1108. RETURN
  1109. > PROCEDURE taste          ! Rückgabe-Charakter in 'key%' und 'key$' (Global)
  1110. catchkey
  1111. key%=INP(2)
  1112. key$=CHR$(key%)
  1113. RETURN
  1114. '
  1115. '
  1116. '    >>>>>>>>>>>>>>>>>>>>>>>>>>> E N D E <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  1117. '
  1118.